SetDailyArray Function

private function SetDailyArray(value) result(array)

populate array of daily values

Arguments

Type IntentOptional Attributes Name
character(len=*) :: value

Return Value real(kind=float), (365)


Variables

Type Visibility Attributes Name Initial
real(kind=float), public :: doyStart
real(kind=float), public :: doyStop
logical, public :: error
integer, public :: i
real(kind=float), public :: scalar
type(Table), public :: valueTable

Source Code

FUNCTION SetDailyArray &
!
( value ) &
!
RESULT ( array )

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *) :: value


!Local declarations:
REAL (KIND = float) :: array (365)
REAL (KIND = float) :: scalar
LOGICAL :: error
TYPE (Table) :: valueTable
INTEGER :: i
REAL (KIND = float) :: doyStart, doyStop

!----------------------------end of declarations-------------------------------

!check that value is a number
scalar = StringToFloat (value, error)
IF  ( error ) THEN !value changes in time
    CALL TableNew (value, valueTable)
    array = 0.
    
    DO i = 1, TableGetNrows (valueTable)
       CALL TableGetValue ( valueIn = REAL (i), &
                             tab = valueTable, &
                             keyIn = 'count', &
                             keyOut ='doy-start', &
                             match = 'exact', &
                             valueOut = doyStart )
      
       CALL TableGetValue ( valueIn = REAL (i), &
                             tab = valueTable, &
                             keyIn = 'count', &
                             keyOut ='doy-stop', &
                             match = 'exact', &
                             valueOut = doyStop )
       
       CALL TableGetValue ( valueIn = REAL (i), &
                             tab = valueTable, &
                             keyIn = 'count', &
                             keyOut ='value', &
                             match = 'exact', &
                             valueOut = scalar )
       
       array ( INT (doyStart) : INT (doyStop) ) = scalar
        
    END DO
    
ELSE !no error, value is a scalar
    array = scalar
END IF

RETURN
END FUNCTION SetDailyArray